home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / baseapp.exe / BAPP10.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-15  |  16KB  |  437 lines
  1. PROGRAM BasicApp;
  2.  
  3. {(c) 1991 John C. Leon}
  4.  
  5. {Version 1.0   9/15/91}
  6.  
  7. {READ THESE COMMENTS BEFORE USING THIS CODE!}
  8.  
  9. {This base application was prepared for my personal use, as I do not wish
  10.  to recreate the wheel with each new TV application.  Because I seem to
  11.  always want the same skeleton in my TV apps, this base set of code has become
  12.  very helpful!
  13.  
  14.  Included in the base app is code for properly handling window numbers,
  15.  enabling a video mode toggle, providing tileable/cascadable windows,
  16.  testing for application-specific conditions before presenting the main
  17.  menu (and showing error message windows if there's a problem), and generating
  18.  a title screen on initialization.
  19.  
  20.  All windows should be descendants of BWindow.  Your descendants can
  21.  freely modify BWindow.Init and BWindow.Done.  As long as they call
  22.  BWindow.Init and BWindow.Done, you can assure yourself that they will
  23.  be tilable/cascadable, and that window numbers will be properly handled.
  24.  
  25.  The BaseApp.BaseWindow procedure opens an empty, generic window.  This is
  26.  provided only so that you can see the use of the SetWinCount procedure, and
  27.  so that you can see properly working window numbers.  To test it out, open
  28.  a few windows.  Then close, say, window #2.  Open a new window, and it will
  29.  use #2 (the first available window number).  If only something as basic as
  30.  this was built into TV, eh?
  31.  
  32.  A generic menubar and statusline are provided, including help contexts.  This
  33.  will be extremely helpful for programmers struggling with how to implement
  34.  help contexts, if like me, you lost a lot of sleep getting it right the
  35.  first time!
  36.  
  37.  The base app also includes code to put up a message box if the application
  38.  fails to initialize.  That is, if you require certain conditions to be met
  39.  before your user can even start the app (data files must be present, etc)
  40.  you can initialize TV anyway and use a message box to state the cause of
  41.  failure.  For this reason, the base application uses the TVision sample unit
  42.  MSGBOX (a VERY useful set of routines!).  To illustrate how this works, THE
  43.  BASE APP REQUIRES THAT THE SOURCE CODE FILE (or any file named BASEAPP.PAS)
  44.  BE PRESENT IN THE CURRENT DIRECTORY.
  45.  
  46.  If you find this code helpful, I'd appreciate a whopping $10.  This'll buy
  47.  you copies of any future utilities, versions, etc, and the legal right to
  48.  use this software.  This is SHAREWARE, folks, *NOT* freeware or public
  49.  domain.  Act accordingly.
  50.  
  51.  Constructive criticism and suggestions always welcome.
  52.  
  53.  John C. Leon
  54.  3807 Wood Gardens Court
  55.  Kingwood, TX  77339
  56.  
  57.  CIS 72426,2077
  58.  
  59.  N.B.  The ColBackground routines (the code to change background color) are
  60.        taken directly from Neil J. Rubenking's book, Turbo Pascal 6.0
  61.        Techniques and Utilities...a MUST for your collection).
  62.  
  63.        Attention Btrieve programmers!  My object-oriented unit for handling
  64.        standard Btrieve files is available currently as FREEWARE.  Makes
  65.        TP6 Btrieve programming a snap!  It is available on CIS in forum
  66.        BPROGA, library 1 (OOP).  Just browse for file BTP*.ZIP
  67.        (* = version number).
  68.  
  69. }
  70.  
  71.  
  72. USES
  73.    App, Dialogs, Objects, Menus, Views, Drivers, MsgBox;
  74.  
  75.  
  76. CONST
  77.    cmSetVideoMode    = 100;
  78.    cmBaseWindow      = 110;
  79.    cmAbout           = 120;
  80.    ErrorInitializing : integer = 0;
  81.    WinCount          : integer = 0;
  82.  
  83.  
  84. TYPE
  85.    BaseApp = object(TApplication)
  86.       constructor Init;
  87.       procedure InitMenuBar   ; virtual;
  88.       procedure InitStatusLine; virtual;
  89.       procedure TitleScreen;
  90.       procedure TileAll;
  91.       procedure CascadeAll;
  92.       procedure SetVideoMode;
  93.       procedure BaseWindow;
  94.       procedure HandleEvent(var Event: TEvent); virtual;
  95.       destructor Done; virtual;
  96.       end;
  97.  
  98.    PColBackground   = ^ColBackground;
  99.    ColBackground    = object(TBackground)
  100.                       Color: Byte;
  101.                       constructor Init(var Bounds: TRect; APat: Char;
  102.                                        AColor: Byte);
  103.                       procedure Draw; virtual;
  104.                       end;
  105.  
  106.    PHelpStatusLine  = ^THelpStatusLine;
  107.    THelpStatusLine  = object(TStatusLine)
  108.                       function Hint(AHelpCtx: Word): string; virtual;
  109.                       end;
  110.  
  111.    PWindow       = ^BWindow;
  112.    BWindow       =  object(TWindow)
  113.                     constructor Init(var Bounds: TRect; WinTitle: string;
  114.                                      WinNumber: integer);
  115.                     destructor Done; virtual;
  116.                     end;
  117.  
  118.  
  119. VAR
  120.    BApp                : BaseApp;
  121.    WinNumberCollection : PStringCollection; {initialized during BaseApp.Init}
  122.    WinNumberString     : string;
  123.    RequiredFile        : text;  {NOT required for basic app, but is used as
  124.                                  an illustration of message box use if app's
  125.                                  required files/conditions are not met and
  126.                                  you DON'T want user to 'enter' application.}
  127.  
  128. constructor BaseApp.Init;
  129. var
  130.    R      : TRect;
  131.    Counter: integer;
  132.    Control: word;
  133. begin
  134.    {Set up the collection of window numbers, sorted automatically from 1 to 9.}
  135.    WinNumberCollection := New(PStringCollection, Init(9,0));
  136.    for Counter := 1 to 9 do
  137.       begin
  138.       str(Counter,WinNumberString);
  139.       WinNumberCollection^.Insert(NewStr(WinNumberString));
  140.       end;
  141.  
  142.   {NOTE: The variable 'ErrorInitializing' MUST be assigned before calling
  143.    TApplication.Init, as TApplication.Init will internally initialize the
  144.    menu and status line.  The base application's overrides of InitMenuBar and
  145.    InitStatusLine depend on ErrorInitializing being assigned.  This location
  146.    in the BaseApp.Init is where you'd put your various app initialization
  147.    tests.  See the case statement below for actions to take on failure of
  148.    your initializations.}
  149.    assign(RequiredFile,'BaseApp.Pas');
  150.    {$I-} reset(RequiredFile); {$I+}
  151.    if ioresult <> 0 then
  152.       ErrorInitializing := 1;
  153.  
  154.    {Call ancestor.}
  155.    TApplication.Init;
  156.  
  157.    {Replace background with one of new color.  Credit to Neil J. Rubenking's
  158.     book, Turbo Pascal 6.0 Techniques and Utilities for this code.}
  159.    Desktop^.Background^.GetExtent(R);
  160.    Desktop^.Delete(Desktop^.Background);
  161.    Dispose(Desktop^.Background, done);
  162.    Desktop^.Background := New(PColBackground, Init(R, #176, 9));
  163.    Desktop^.Insert(Desktop^.Background);
  164.  
  165.    {No windows open at initialization, so disable the Tile and Cascade cmds
  166.     on menu.}
  167.    DisableCommands([cmTile, cmCascade]);
  168.  
  169.    {Universally turn off the Video Mode option on menu if user screen can't
  170.     handle it.}
  171.    if HiResScreen = false then
  172.      DisableCommands([cmSetVideoMode]);
  173.  
  174.    {Put up a generic title screen.  Note what's done if there's an error
  175.     initializing your app.  Expand this case statement as required to put
  176.     up different messages depending on which of you application's requirements
  177.     was not met.}
  178.    case ErrorInitializing of
  179.       0: TitleScreen;
  180.       1: Control := MessageBox(^C'Required file not found'^M^C'Cannot run Base App',
  181.                                 nil, mfError + mfOKButton);
  182.       end;
  183. end;
  184.  
  185. destructor BaseApp.Done;
  186. begin
  187.    TApplication.Done;
  188.    dispose(WinNumberCollection, Done); {Call this AFTER calling ancestor!}
  189. end;
  190.  
  191. procedure SetWinCount;
  192. function GetWinCount(WString: PString): boolean; far;
  193.    begin
  194.    GetWinCount := WString <> nil;  {effectively sets position to first}
  195.    end;                            {*available* window number!        }
  196. var
  197.    Code            : integer;
  198.    PWinNumber      : pointer;
  199. begin
  200.    if WinNumberCollection^.Count = 0 then {if #'s 1 thru 9 have been used}
  201.          WinCount := wnNoNumber
  202.       else
  203.          begin
  204.          PWinNumber := WinNumberCollection^.FirstThat(@GetWinCount);
  205.          WinNumberString := string(PWinNumber^);
  206.          val(WinNumberString, WinCount, Code);
  207.          WinNumberCollection^.Delete(PWinNumber);
  208.          disposestr(PWinNumber);
  209.          end;
  210. end;
  211.  
  212. constructor ColBackground.Init(var Bounds: TRec